***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
*** This Program already converted to Y2K                                                                                                                                                                                                                 
*** S&T Departement     on 29 April 1999 by Ben.Rahman                                                                                                                                                                                                    
***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
set cent on                                                                                                                                                                                                                                               
set function 10 to space(5)                                                                                                                                                                                                                               
dr='n:'                                                                                                                                                                                                                                                   
f1='drugs'                                                                                                                                                                                                                                                
f11='drugnm'                                                                                                                                                                                                                                              
f12='drugen'                                                                                                                                                                                                                                              
set exclu off                                                                                                                                                                                                                                             
use &dr&f1 index &dr&f1,&dr&f11,&dr&f12                                                                                                                                                                                                                   
go bottom                                                                                                                                                                                                                                                 
set colo to bg+/b,w+/n                                                                                                                                                                                                                                    
@ 4,1 clear to 6,50                                                                                                                                                                                                                                       
@ 8,1 clear to 23,78                                                                                                                                                                                                                                      
DO BOXT WITH 4,3,"MAINTAIN DRUG RECORDS",'W+','RB',.F.,.T.                                                                                                                                                                                                
SET COLO TO BG+/B,W+/N                                                                                                                                                                                                                                    
@ 8, 3 say 'Item Code          :'                                                                                                                                                                                                                         
@ 9, 3 say 'Item Description   :'                                                                                                                                                                                                                         
@ 9,53 say 'Type :'                                                                                                                                                                                                                                       
@ 10, 3 say 'Quantity           :'                                                                                                                                                                                                                        
@ 10,53 say 'Unit :'                                                                                                                                                                                                                                      
@ 11, 3 SAY "Generic            :"                                                                                                                                                                                                                        
@ 12, 3 say "Generic Code       :"                                                                                                                                                                                                                        
@ 13, 3 say 'Unit of Stock      :'                                                                                                                                                                                                                        
@ 14, 3 say 'Whole Unit  (Y/N)  :'                                                                                                                                                                                                                        
@ 15, 3 say 'Unit of Sale       :'                                                                                                                                                                                                                        
@ 16, 3 say 'Base Selling Price :'                                                                                                                                                                                                                        
@ 17, 3 say 'Next Selling Price :'                                                                                                                                                                                                                        
@ 18, 3 say 'Date Next Price Applies : '                                                                                                                                                                                                                  
@ 19, 3 say 'Clinic Program(Y/N):'                                                                                                                                                                                                                        
@ 20, 3 say 'For Sale (Y/N)     :'                                                                                                                                                                                                                        
set colo to gr+/rb,w+/n                                                                                                                                                                                                                                   
@ 12,45 clear to 22,77                                                                                                                                                                                                                                    
@ 12,45 to 22,77 double                                                                                                                                                                                                                                   
set colo to gr+/rb,w+/n                                                                                                                                                                                                                                   
@ 13,47 say 'Minimum Stock Level : '                                                                                                                                                                                                                      
@ 14,47 say 'Maximum Stock Level : '                                                                                                                                                                                                                      
@ 16,47 say 'Physical Balance    : '                                                                                                                                                                                                                      
@ 17,47 say 'On Order Balance    : '                                                                                                                                                                                                                      
@ 18,47 say 'Allocated Balance   : '                                                                                                                                                                                                                      
@ 20,47 say 'Latest Cost         : '                                                                                                                                                                                                                      
@ 21,47 say 'Average Cost        : '                                                                                                                                                                                                                      
set colo to bg+/b,w+/n                                                                                                                                                                                                                                    
*set color to w                                                                                                                                                                                                                                           
del_rec = 'N'                                                                                                                                                                                                                                             
option = 1                                                                                                                                                                                                                                                
do while option <9                                                                                                                                                                                                                                        
*   set deli off                                                                                                                                                                                                                                          
*   set inten  off                                                                                                                                                                                                                                        
   set colo to w+/N,w+/n                                                                                                                                                                                                                                  
   record_no = recno()                                                                                                                                                                                                                                    
   kode     = drug_code                                                                                                                                                                                                                                   
   name     = drug_name                                                                                                                                                                                                                                   
   unst     = 1                                                                                                                                                                                                                                           
   wunit    = whol_unit                                                                                                                                                                                                                                   
   pric     = sale_price                                                                                                                                                                                                                                  
   npric    = new_price                                                                                                                                                                                                                                   
   tipe     = drug_type                                                                                                                                                                                                                                   
   qant     = drug_qant                                                                                                                                                                                                                                   
   Unit     = drug_unit                                                                                                                                                                                                                                   
   GENE     = GENERIC                                                                                                                                                                                                                                     
   gcod     = GENE_CODE                                                                                                                                                                                                                                   
   drheal   = healthline                                                                                                                                                                                                                                  
   bunit    = buy_unit                                                                                                                                                                                                                                    
   sunit    = sell_unit                                                                                                                                                                                                                                   
   buyinsel = buy_sell_r                                                                                                                                                                                                                                  
   efetang  = date_Acti                                                                                                                                                                                                                                   
   stmin    = st_refil                                                                                                                                                                                                                                    
   stmax    = st_max                                                                                                                                                                                                                                      
   stphy    = st_act_tot                                                                                                                                                                                                                                  
   stono    = st_on_orde                                                                                                                                                                                                                                  
   stall    = st_allocat                                                                                                                                                                                                                                  
   latec    = u_pr_l_pur                                                                                                                                                                                                                                  
   averc    = st_av_pr_s                                                                                                                                                                                                                                  
   if for_sale =.T.                                                                                                                                                                                                                                       
      fsale  = 'Y'                                                                                                                                                                                                                                        
   ELse                                                                                                                                                                                                                                                   
      fsale  = 'N'                                                                                                                                                                                                                                        
   endif                                                                                                                                                                                                                                                  
   if whol_unit                                                                                                                                                                                                                                           
      wunit  = 'Y'                                                                                                                                                                                                                                        
   ELse                                                                                                                                                                                                                                                   
      wunit  = 'N'                                                                                                                                                                                                                                        
   endif                                                                                                                                                                                                                                                  
                                                                                                                                                                                                                                                          
                                                                                                                                                                                                                                                          
                                                                                                                                                                                                                                                          
   @ 8,25 say kode                                                                                                                                                                                                                                        
   @ 9,25 say name                                                                                                                                                                                                                                        
   @ 9,60 say tipe                                                                                                                                                                                                                                        
   @ 10,25 say qant                                                                                                                                                                                                                                       
   @ 10,60 say unit                                                                                                                                                                                                                                       
   @ 11,25 SAY GENE                                                                                                                                                                                                                                       
   @ 12,25 say gcod                                                                                                                                                                                                                                       
   @ 13,25 say unst pict '9,999'                                                                                                                                                                                                                          
   @ 13,32 say bunit                                                                                                                                                                                                                                      
   @ 14,25 say wunit                                                                                                                                                                                                                                      
   @ 15,25 say buyinsel pict '9,999'                                                                                                                                                                                                                      
   @ 15,32 say sunit                                                                                                                                                                                                                                      
   DO SAYG WITH 16,25,PRIC,'9,999.99','999,999'                                                                                                                                                                                                           
   DO SAYG WITH 17,25,NPRIC,'9,999.99','999,999'                                                                                                                                                                                                          
*   @ 16,25 say pric pict '999,999'                                                                                                                                                                                                                       
*   @ 17,25 say npric pict '999,999'                                                                                                                                                                                                                      
   @ 18,29 say efetang pict '99/99/9999'                                                                                                                                                                                                                  
      @ 19,25 say drheal pict 'Y'                                                                                                                                                                                                                         
   @ 20,25 say fsale pict '@!'                                                                                                                                                                                                                            
   set colo to gr+/RB,w+/n                                                                                                                                                                                                                                
   @ 13,69 say stmin pict '999,999'                                                                                                                                                                                                                       
   @ 14,69 say stmax pict '999,999'                                                                                                                                                                                                                       
   @ 16,69 say stphy pict '999,999'                                                                                                                                                                                                                       
   @ 17,69 say stono pict '999,999'                                                                                                                                                                                                                       
   @ 18,69 say stall pict '999,999'                                                                                                                                                                                                                       
   DO SAYG WITH 20,69,LATEC,'9,999.99','999,999'                                                                                                                                                                                                          
   DO SAYG WITH 21,69,AVERC,'9,999.99','999,999'                                                                                                                                                                                                          
*   @ 20,69 say latec pict '999,999'                                                                                                                                                                                                                      
*   @ 21,69 say averc pict '999,999'                                                                                                                                                                                                                      
   set colo to bg+/b,w+/n                                                                                                                                                                                                                                 
   do mn_formm                                                                                                                                                                                                                                            
   do case                                                                                                                                                                                                                                                
      case option = 1                                                                                                                                                                                                                                     
           lay1=savescreen(0,0,24,79)                                                                                                                                                                                                                     
           set colo to bg+/b,w+/n                                                                                                                                                                                                                         
           @ 7,1 clear to 22,78                                                                                                                                                                                                                           
           set inte on                                                                                                                                                                                                                                    
           PIL1=1                                                                                                                                                                                                                                         
           DO BOX3 WITH 8,3,"DO YOU WANT TO SORT by :","Item Code","Item Description","Generic Name",'GR+','gr','GR+','R',PIL1,.F.,.T.                                                                                                                    
           IF LASTKEY()=27                                                                                                                                                                                                                                
              set colo to bg+/b,w+/n                                                                                                                                                                                                                      
              RESTSCREEN(0,0,24,79,LAY1)                                                                                                                                                                                                                  
              loop                                                                                                                                                                                                                                        
           ENDIF                                                                                                                                                                                                                                          
           kunci=space(5)                                                                                                                                                                                                                                 
           do boxe with 11,3,'Enter Initial of Key Name : ','KUNCI','N','BG','W+','N',5,.T.,.T.                                                                                                                                                           
           if lastkey()=27                                                                                                                                                                                                                                
                 set colo to bg+/b,w+/n                                                                                                                                                                                                                   
                 RESTSCREEN(0,0,24,79,LAY1)                                                                                                                                                                                                               
                 loop                                                                                                                                                                                                                                     
           endif                                                                                                                                                                                                                                          
           DO CASE                                                                                                                                                                                                                                        
           CASE PIL1=1                                                                                                                                                                                                                                    
                do inpcode                                                                                                                                                                                                                                
           case pil1=2                                                                                                                                                                                                                                    
                do inpname                                                                                                                                                                                                                                
           case pil1=3                                                                                                                                                                                                                                    
                do inpgene                                                                                                                                                                                                                                
           endcase                                                                                                                                                                                                                                        
           set inde to &dr&f1                                                                                                                                                                                                                             
           SEEK KODE                                                                                                                                                                                                                                      
           IF EOF()                                                                                                                                                                                                                                       
              go bott                                                                                                                                                                                                                                     
*               LAYAR=SAVESCREEN(0,0,24,79)                                                                                                                                                                                                               
               set colo to W+/b,w+/B                                                                                                                                                                                                                      
               @ 23,09 clea to 23,69                                                                                                                                                                                                                      
               @ 23,10 SAY 'NOT EXIST'                                                                                                                                                                                                                    
               WAIT ' '                                                                                                                                                                                                                                   
               set colo to bg+/b,w+/n                                                                                                                                                                                                                     
               RESTSCREEN(0,0,24,79,LAY1)                                                                                                                                                                                                                 
               loop                                                                                                                                                                                                                                       
           endif                                                                                                                                                                                                                                          
           set colo to bg+/b,w+/n                                                                                                                                                                                                                         
           RESTSCREEN(0,0,24,79,LAY1)                                                                                                                                                                                                                     
                                                                                                                                                                                                                                                          
      case option = 2                                                                                                                                                                                                                                     
         go top                                                                                                                                                                                                                                           
      case option = 3                                                                                                                                                                                                                                     
         go bottom                                                                                                                                                                                                                                        
      case option = 4                                                                                                                                                                                                                                     
         skip                                                                                                                                                                                                                                             
         if eof()                                                                                                                                                                                                                                         
            go bottom                                                                                                                                                                                                                                     
            LAYAR=SAVESCREEN(0,0,24,79)                                                                                                                                                                                                                   
            set colo to W+/b,w+/B                                                                                                                                                                                                                         
            @ 23,09 clea to 23,69                                                                                                                                                                                                                         
            @ 23,10 SAY 'LAST RECORD'                                                                                                                                                                                                                     
            WAIT ' '                                                                                                                                                                                                                                      
            SET COLO TO                                                                                                                                                                                                                                   
            RESTSCREEN(0,0,24,79,LAYAR)                                                                                                                                                                                                                   
         endif                                                                                                                                                                                                                                            
      case option = 5                                                                                                                                                                                                                                     
         skip -1                                                                                                                                                                                                                                          
         if bof()                                                                                                                                                                                                                                         
            go top                                                                                                                                                                                                                                        
            LAYAR=SAVESCREEN(0,0,24,79)                                                                                                                                                                                                                   
            set colo to W+/b,w+/B                                                                                                                                                                                                                         
            @ 23,09 clea to 23,69                                                                                                                                                                                                                         
            @ 23,10 SAY 'FIRST RECORD'                                                                                                                                                                                                                    
            WAIT ' '                                                                                                                                                                                                                                      
            SET COLO TO                                                                                                                                                                                                                                   
            RESTSCREEN(0,0,24,79,LAYAR)                                                                                                                                                                                                                   
         endif                                                                                                                                                                                                                                            
      case option = 6                                                                                                                                                                                                                                     
         SET DELI OFF                                                                                                                                                                                                                                     
         SET INTE ON                                                                                                                                                                                                                                      
         @ 8,25 GET KODE PICT '@!'                                                                                                                                                                                                                        
         @ 9,25 get name pict '@!'                                                                                                                                                                                                                        
         @ 9,60 get tipe pict '@!'                                                                                                                                                                                                                        
         @ 10,25 get qant pict '@!'                                                                                                                                                                                                                       
         @ 10,60 get unit pict '@!'                                                                                                                                                                                                                       
         @ 11,25 GET GENE PICT '@!'                                                                                                                                                                                                                       
         @ 12,25 get gcod                                                                                                                                                                                                                                 
         @ 13,25 get unst pict '9,999'                                                                                                                                                                                                                    
         @ 13,32 get bunit pict '@!'                                                                                                                                                                                                                      
         read                                                                                                                                                                                                                                             
         DO WHILE .T.                                                                                                                                                                                                                                     
            @ 14,25 GET wunit PICT '@!'                                                                                                                                                                                                                   
            READ                                                                                                                                                                                                                                          
            IF wunit='Y' .OR. wunit='N'                                                                                                                                                                                                                   
               if wunit='Y'                                                                                                                                                                                                                               
                  buyinsel=unst                                                                                                                                                                                                                           
                  sunit=bunit                                                                                                                                                                                                                             
                  wuni=.t.                                                                                                                                                                                                                                
               else                                                                                                                                                                                                                                       
                  wuni=.f.                                                                                                                                                                                                                                
               endif                                                                                                                                                                                                                                      
               EXIT                                                                                                                                                                                                                                       
            ENDIF                                                                                                                                                                                                                                         
         ENDDO                                                                                                                                                                                                                                            
         @ 15,25 get buyinsel pict '9,999'                                                                                                                                                                                                                
         @ 15,32 get sunit pict '@!'                                                                                                                                                                                                                      
         DO GETS WITH 16,25,PRIC,'9,999.99','999,999'                                                                                                                                                                                                     
         DO GETS WITH 17,25,NPRIC,'9,999.99','999,999'                                                                                                                                                                                                    
*         @ 16,25 get pric pict '999,999'                                                                                                                                                                                                                 
*         @ 17,25 get npric pict '999,999'                                                                                                                                                                                                                
         @ 18,29 get efetang pict '99/99/9999'                                                                                                                                                                                                            
            @ 19,25 get drheal pict 'Y'                                                                                                                                                                                                                   
         read                                                                                                                                                                                                                                             
         DO WHILE .T.                                                                                                                                                                                                                                     
            @ 20,25 GET fsale PICT '@!'                                                                                                                                                                                                                   
            READ                                                                                                                                                                                                                                          
            IF fsale='Y' .OR. fsale='N'                                                                                                                                                                                                                   
               EXIT                                                                                                                                                                                                                                       
            ENDIF                                                                                                                                                                                                                                         
         ENDDO                                                                                                                                                                                                                                            
         if fsale='Y'                                                                                                                                                                                                                                     
            sale=.t.                                                                                                                                                                                                                                      
         else                                                                                                                                                                                                                                             
            sale=.f.                                                                                                                                                                                                                                      
         endif                                                                                                                                                                                                                                            
         @ 13,69 GET stmin pict '999,999'                                                                                                                                                                                                                 
         @ 14,69 GET stmax pict '999,999'                                                                                                                                                                                                                 
         READ                                                                                                                                                                                                                                             
         LAYAR=SAVESCREEN(0,0,24,79)                                                                                                                                                                                                                      
         choice = ' '                                                                                                                                                                                                                                     
         do get_optn with 'SAVE (Y/N)','YN',choice                                                                                                                                                                                                        
         if choice = 'Y'                                                                                                                                                                                                                                  
            if rec_lock()                                                                                                                                                                                                                                 
               repl drug_code   with kode                                                                                                                                                                                                                 
               repl drug_name   with name                                                                                                                                                                                                                 
               repl drug_type   with tipe                                                                                                                                                                                                                 
               repl drug_unit   with unit                                                                                                                                                                                                                 
               repl drug_qant   with qant                                                                                                                                                                                                                 
               repl whol_unit   with wuni                                                                                                                                                                                                                 
               REPL GENERIC     WITH GENE                                                                                                                                                                                                                 
               REPL GENE_CODE   WITH GCOD                                                                                                                                                                                                                 
               repl healthline  with drheal                                                                                                                                                                                                               
               repl buy_unit    with bunit                                                                                                                                                                                                                
               repl sell_unit   with sunit                                                                                                                                                                                                                
               repl for_sale    with sale                                                                                                                                                                                                                 
               repl buy_sell_r  with buyinsel                                                                                                                                                                                                             
               repl sale_price  with pric                                                                                                                                                                                                                 
               repl new_price   with npric                                                                                                                                                                                                                
               repl date_acti   with efetang                                                                                                                                                                                                              
               REPL st_refil    WITH STMIN                                                                                                                                                                                                                
               REPL st_max      WITH STMAX                                                                                                                                                                                                                
            endif                                                                                                                                                                                                                                         
            unlock                                                                                                                                                                                                                                        
         endif                                                                                                                                                                                                                                            
         RESTSCREEN(0,0,24,79,LAYAR)                                                                                                                                                                                                                      
      case option = 7                                                                                                                                                                                                                                     
         set colo to w+/n,w+/n                                                                                                                                                                                                                            
         do while .T.                                                                                                                                                                                                                                     
            kode     = spac(5)                                                                                                                                                                                                                            
            name     = spac(20)                                                                                                                                                                                                                           
            tipe     = spac(12)                                                                                                                                                                                                                           
            unit     = spac(6)                                                                                                                                                                                                                            
            qant     = spac(6)                                                                                                                                                                                                                            
            drheal   = .f.                                                                                                                                                                                                                                
            GENE     = SPACE(40)                                                                                                                                                                                                                          
            gcod     = space(6)                                                                                                                                                                                                                           
            tcod     = space(1)                                                                                                                                                                                                                           
            pric     = 0                                                                                                                                                                                                                                  
            bunit    = spac(12)                                                                                                                                                                                                                           
            sunit    = spac(12)                                                                                                                                                                                                                           
            stref    = 0                                                                                                                                                                                                                                  
            stmax    = 0                                                                                                                                                                                                                                  
            fsale    = ' '                                                                                                                                                                                                                                
            buyinsel = 0                                                                                                                                                                                                                                  
            clref    = 0                                                                                                                                                                                                                                  
            wunit    = ' '                                                                                                                                                                                                                                
            clmax    = 0                                                                                                                                                                                                                                  
            npric    = 0                                                                                                                                                                                                                                  
            efetang  = ctod('  /  /    ')                                                                                                                                                                                                                 
            unst     = 1                                                                                                                                                                                                                                  
            stmin    = 0                                                                                                                                                                                                                                  
            stmax    = 0                                                                                                                                                                                                                                  
            stphy    = 0                                                                                                                                                                                                                                  
            stono    = 0                                                                                                                                                                                                                                  
            stall    = 0                                                                                                                                                                                                                                  
            latec    = 0                                                                                                                                                                                                                                  
            averc    = 0                                                                                                                                                                                                                                  
            @ 8,25 say kode                                                                                                                                                                                                                               
            @ 9,25 say name                                                                                                                                                                                                                               
            @ 9,60 say tipe                                                                                                                                                                                                                               
            @ 10,25 say qant                                                                                                                                                                                                                              
            @ 10,60 say unit                                                                                                                                                                                                                              
            @ 11,25 SAY GENE                                                                                                                                                                                                                              
            @ 12,25 say gcod                                                                                                                                                                                                                              
            @ 13,25 say unst pict '9,999'                                                                                                                                                                                                                 
            @ 13,32 say bunit                                                                                                                                                                                                                             
            @ 14,25 say wunit                                                                                                                                                                                                                             
            @ 15,32 say sunit                                                                                                                                                                                                                             
            @ 15,25 say buyinsel pict '9,999'                                                                                                                                                                                                             
            @ 15,32 say sunit                                                                                                                                                                                                                             
            @ 16,25 say pric pict '999,999'                                                                                                                                                                                                               
            @ 17,25 say npric pict '999,999'                                                                                                                                                                                                              
            @ 18,29 say efetang pict '99/99/9999'                                                                                                                                                                                                         
               @ 19,25 say drheal pict 'Y'                                                                                                                                                                                                                
            @ 20,25 say fsale pict '999,999'                                                                                                                                                                                                              
            set colo to gr+/rb,w+/n                                                                                                                                                                                                                       
            @ 13,69 say stmin pict '999,999'                                                                                                                                                                                                              
            @ 14,69 say stmax pict '999,999'                                                                                                                                                                                                              
            @ 16,69 say stphy pict '999,999'                                                                                                                                                                                                              
            @ 17,69 say stono pict '999,999'                                                                                                                                                                                                              
            @ 18,69 say stall pict '999,999'                                                                                                                                                                                                              
            @ 20,69 say latec pict '999,999'                                                                                                                                                                                                              
            @ 21,69 say averc pict '999,999'                                                                                                                                                                                                              
            set colo to bg+/b,w+/n                                                                                                                                                                                                                        
            set deli off                                                                                                                                                                                                                                  
            set inte on                                                                                                                                                                                                                                   
            @ 8,25 GET KODE PICT '@!'                                                                                                                                                                                                                     
            READ                                                                                                                                                                                                                                          
            IF KODE=SPAC(5)                                                                                                                                                                                                                               
               EXIT                                                                                                                                                                                                                                       
            ENDIF                                                                                                                                                                                                                                         
            SEEK KODE                                                                                                                                                                                                                                     
            IF .NOT. EOF()                                                                                                                                                                                                                                
               LAYAR=SAVESCREEN(0,0,24,79)                                                                                                                                                                                                                
               set colo to W+/b,w+/B                                                                                                                                                                                                                      
               @ 23,09 clea to 23,69                                                                                                                                                                                                                      
               @ 23,10 SAY 'EXIST'                                                                                                                                                                                                                        
               WAIT ' '                                                                                                                                                                                                                                   
               SET COLO TO                                                                                                                                                                                                                                
               RESTSCREEN(0,0,24,79,LAYAR)                                                                                                                                                                                                                
               loop                                                                                                                                                                                                                                       
            endif                                                                                                                                                                                                                                         
            if m->kode=space(5)                                                                                                                                                                                                                           
               exit                                                                                                                                                                                                                                       
            endif                                                                                                                                                                                                                                         
            @ 9,25 get name pict '@!'                                                                                                                                                                                                                     
            @ 9,60 get tipe pict '@!'                                                                                                                                                                                                                     
            @ 10,25 get qant pict '@!'                                                                                                                                                                                                                    
            @ 10,60 get unit pict '@!'                                                                                                                                                                                                                    
            @ 11,25 GET GENE PICT '@!'                                                                                                                                                                                                                    
            @ 12,25 get gcod                                                                                                                                                                                                                              
            @ 13,25 get unst pict '9,999'                                                                                                                                                                                                                 
            @ 13,32 get bunit pict '@!'                                                                                                                                                                                                                   
            read                                                                                                                                                                                                                                          
            DO WHILE .T.                                                                                                                                                                                                                                  
               @ 14,25 GET wunit PICT '@!'                                                                                                                                                                                                                
               READ                                                                                                                                                                                                                                       
               IF wunit='Y' .OR. wunit='N'                                                                                                                                                                                                                
                  if wunit='Y'                                                                                                                                                                                                                            
                     buyinsel=unst                                                                                                                                                                                                                        
                     sunit=bunit                                                                                                                                                                                                                          
                     wuni=.t.                                                                                                                                                                                                                             
                  else                                                                                                                                                                                                                                    
                     wuni=.f.                                                                                                                                                                                                                             
                  endif                                                                                                                                                                                                                                   
                  EXIT                                                                                                                                                                                                                                    
               ENDIF                                                                                                                                                                                                                                      
            ENDDO                                                                                                                                                                                                                                         
            @ 15,25 get buyinsel pict '9,999'                                                                                                                                                                                                             
            @ 15,32 get sunit pict '@!'                                                                                                                                                                                                                   
            DO GETS WITH 16,25,PRIC,'9,999.99','999,999'                                                                                                                                                                                                  
            DO GETS WITH 17,25,NPRIC,'9,999.99','999,999'                                                                                                                                                                                                 
*            @ 16,25 get pric pict '999,999'                                                                                                                                                                                                              
*            @ 17,25 get npric pict '999,999'                                                                                                                                                                                                             
            @ 18,29 get efetang pict '99/99/9999'                                                                                                                                                                                                         
               @ 19,25 get drheal pict 'Y'                                                                                                                                                                                                                
            read                                                                                                                                                                                                                                          
            DO WHILE .T.                                                                                                                                                                                                                                  
               @ 20,25 GET fsale PICT '@!'                                                                                                                                                                                                                
               READ                                                                                                                                                                                                                                       
               IF fsale='Y' .OR. fsale='N'                                                                                                                                                                                                                
                  EXIT                                                                                                                                                                                                                                    
               ENDIF                                                                                                                                                                                                                                      
            ENDDO                                                                                                                                                                                                                                         
            if fsale='Y'                                                                                                                                                                                                                                  
               sale=.t.                                                                                                                                                                                                                                   
            else                                                                                                                                                                                                                                          
               sale=.f.                                                                                                                                                                                                                                   
            endif                                                                                                                                                                                                                                         
            @ 13,69 GET stmin pict '999,999'                                                                                                                                                                                                              
            @ 14,69 GET stmax pict '999,999'                                                                                                                                                                                                              
            @ 16,69 GET stphy pict '999,999'                                                                                                                                                                                                              
            @ 17,69 GET stono pict '999,999'                                                                                                                                                                                                              
            @ 18,69 GET stall pict '999,999'                                                                                                                                                                                                              
            DO GETS WITH 20,69,LATEC,'9,999.99','999,999'                                                                                                                                                                                                 
            DO GETS WITH 21,69,AVERC,'9,999.99','999,999'                                                                                                                                                                                                 
 *           @ 20,69 GET latec pict '999,999'                                                                                                                                                                                                             
 *           @ 21,69 GET averc pict '999,999'                                                                                                                                                                                                             
            READ                                                                                                                                                                                                                                          
                                                                                                                                                                                                                                                          
            LAYAR=SAVESCREEN(0,0,24,79)                                                                                                                                                                                                                   
            choice = 'Y'                                                                                                                                                                                                                                  
            do get_optn with 'SAVE (Y/N)','YN',choice                                                                                                                                                                                                     
            if choice = 'Y'                                                                                                                                                                                                                               
               set inde to &dr&f1,&dr&f11,&dr&f12                                                                                                                                                                                                         
               if fil_lock()                                                                                                                                                                                                                              
                  append blank                                                                                                                                                                                                                            
               endif                                                                                                                                                                                                                                      
               if rec_lock()                                                                                                                                                                                                                              
                  repl drug_code   with kode                                                                                                                                                                                                              
                  repl drug_name   with name                                                                                                                                                                                                              
                  repl drug_type   with tipe                                                                                                                                                                                                              
                  repl whol_unit   with wuni                                                                                                                                                                                                              
                  repl drug_unit   with unit                                                                                                                                                                                                              
                  repl drug_qant   with qant                                                                                                                                                                                                              
                  REPL GENERIC     WITH GENE                                                                                                                                                                                                              
                  REPL GENE_CODE   WITH GCOD                                                                                                                                                                                                              
                  repl healthline  with drheal                                                                                                                                                                                                            
                  repl buy_unit    with bunit                                                                                                                                                                                                             
                  repl sell_unit   with sunit                                                                                                                                                                                                             
                  repl for_sale    with sale                                                                                                                                                                                                              
                  repl buy_sell_r  with buyinsel                                                                                                                                                                                                          
                  repl sale_price  with pric                                                                                                                                                                                                              
                  repl new_price   with npric                                                                                                                                                                                                             
                  repl date_acti   with efetang                                                                                                                                                                                                           
                  REPL st_refil    WITH STMIN                                                                                                                                                                                                             
                  REPL st_max      WITH STMAX                                                                                                                                                                                                             
                  REPL st_act_tot  WITH STPHY                                                                                                                                                                                                             
                                                                                                                                                                                                                                                          
                  REPL ST_ACT_BUY WITH INT(ST_ACT_TOT/BUY_SELL_R)                                                                                                                                                                                         
                  REPL ST_ACT_SEL WITH ST_ACT_TOT-(ST_ACT_BUY*BUY_SELL_R)                                                                                                                                                                                 
                                                                                                                                                                                                                                                          
                  REPL st_on_orde  WITH STONO                                                                                                                                                                                                             
                  REPL st_allocat  WITH STALL                                                                                                                                                                                                             
                  REPL u_pr_l_pur  WITH LATEC                                                                                                                                                                                                             
                  REPL st_av_pr_s  WITH AVERC                                                                                                                                                                                                             
               endif                                                                                                                                                                                                                                      
               unlock                                                                                                                                                                                                                                     
            endif                                                                                                                                                                                                                                         
            RESTSCREEN(0,0,24,79,LAYAR)                                                                                                                                                                                                                   
            loop                                                                                                                                                                                                                                          
         enddo                                                                                                                                                                                                                                            
      case option=8                                                                                                                                                                                                                                       
            LAYAR=SAVESCREEN(0,0,24,79)                                                                                                                                                                                                                   
            choice = 'Y'                                                                                                                                                                                                                                  
            do get_optn with 'DELETE (Y/N)','YN',choice                                                                                                                                                                                                   
            if choice = 'Y'                                                                                                                                                                                                                               
               SELE 1                                                                                                                                                                                                                                     
               IF REC_LOCK()                                                                                                                                                                                                                              
                  DELE                                                                                                                                                                                                                                    
               ENDIF                                                                                                                                                                                                                                      
               UNLOCK                                                                                                                                                                                                                                     
               GO TOP                                                                                                                                                                                                                                     
            ELSE                                                                                                                                                                                                                                          
               RESTSCREEN(0,0,24,79,LAYAR)                                                                                                                                                                                                                
               GO TOP                                                                                                                                                                                                                                     
               LOOP                                                                                                                                                                                                                                       
            ENDIF                                                                                                                                                                                                                                         
      other                                                                                                                                                                                                                                               
         loop                                                                                                                                                                                                                                             
   endcase                                                                                                                                                                                                                                                
enddo                                                                                                                                                                                                                                                     
close data                                                                                                                                                                                                                                                
*close index                                                                                                                                                                                                                                              
set inte on                                                                                                                                                                                                                                               
return                                                                                                                                                                                                                                                    
                                                                                                                                                                                                                                                          
